home *** CD-ROM | disk | FTP | other *** search
/ Planet Source Code Jumbo …e CD Visual Basic 1 to 7 / 3_2004-2005.ISO / Data / Zips / [!!!!!__XT183827192005.psc / Class Modules / clsXThemeVisualStudio2003.cls < prev   
Text File  |  2004-10-27  |  16KB  |  414 lines
  1. VERSION 1.0 CLASS
  2. BEGIN
  3.   MultiUse = -1  'True
  4.   Persistable = 0  'NotPersistable
  5.   DataBindingBehavior = 0  'vbNone
  6.   DataSourceBehavior  = 0  'vbNone
  7.   MTSTransactionMode  = 0  'NotAnMTSObject
  8. END
  9. Attribute VB_Name = "xThemeVisualStudio2003"
  10. Attribute VB_GlobalNameSpace = False
  11. Attribute VB_Creatable = False
  12. Attribute VB_PredeclaredId = False
  13. Attribute VB_Exposed = False
  14. 'xThemeVisualStudio2003 :   Theme mimics the Visual Studio .Net 2003 tabs
  15. '                           I found them cool so i implemented them
  16. '
  17. '                           See ITheme for implemented function description
  18.  
  19. Option Explicit
  20.  
  21. Implements ITheme
  22.  
  23. '====Constant Variables===============================================================================================
  24. Private Const m_c_iPROP_PAGE_BORDER_AND_TEXT_DISTANCE As Integer = 7   'the distance between the text and the border in a Property Pages style tab
  25. Private Const m_c_iPROP_PAGE_INACTIVE_TOP As Integer = 2      'the top for the property page (inactive property page)
  26. '=====================================================================================================================
  27.  
  28. '====Private Variables================================================================================================
  29. Private m_oXTab As XTab
  30.  
  31.  
  32. 'following property are cached (locally) for improved performance
  33. Private m_lHDC As Long
  34. Private m_iActiveTab As Integer
  35. Private m_iActiveTabHeight As Integer
  36. Private m_iInActiveTabHeight As Integer
  37. Private m_iTabCount As Integer
  38. Private m_bIsFocused As Boolean
  39. Private m_iScaleWidth As Integer
  40. Private m_iScaleHeight As Integer
  41. Private m_lOuterBorderColor As Long
  42. Private m_lBottomRightInnerBorderColor As Long
  43. Private m_lActiveTabForeColor As Long
  44. Private m_lActiveTabBackStartColor As Long
  45. Private m_lActiveTabBackEndColor As Long
  46. Private m_lInActiveTabForeColor As Long
  47. Private m_lInActiveTabBackStartColor As Long
  48. Private m_lInActiveTabBackEndColor As Long
  49. Private m_lDisabledTabForeColor As Long
  50. Private m_lDisabledTabBackColor As Long
  51. Private m_iIconSize As Integer
  52. '=====================================================================================================================
  53.  
  54.  
  55. '====Event Handlers===================================================================================================
  56. Private Sub ITheme_DrawBackground()
  57.   
  58.   Call pCacheControlProperties     'cache the control proerties for faster access
  59.   Select Case m_oXTab.TabStyle
  60.     Case xStyleTabbedDialog:
  61.       Call ITheme_DrawBackgroundTabbedDialog
  62.     Case xStylePropertyPages:
  63.       Call ITheme_DrawBackgroundPropertyPages
  64.   End Select
  65. End Sub
  66.  
  67. Private Sub ITheme_DrawBackgroundPropertyPages()
  68.   Dim iTmp As Integer
  69.   
  70.   'get the larger of the active tab height and inactive tab height
  71.   iTmp = IIf(m_iActiveTabHeight > m_iInActiveTabHeight, m_iActiveTabHeight, m_iInActiveTabHeight)
  72.   
  73.   With m_oXTab
  74.     
  75.     .pCls   'clear the control
  76.     
  77.     
  78.     'fill background color based on tab's enabled property
  79.     If .aryTabs(m_iActiveTab).Enabled Then
  80.       .lBackColor = m_lActiveTabBackEndColor
  81.     Else
  82.       .lBackColor = m_lDisabledTabBackColor
  83.     End If
  84.         
  85.     'draw inner shadow (left)
  86.     .pLine 0, iTmp, 0, m_iScaleHeight - 1, m_lOuterBorderColor
  87.     
  88.     
  89.     'draw inner shadow (right)
  90.     .pLine m_iScaleWidth - 1, iTmp, m_iScaleWidth - 1, m_iScaleHeight - 1, m_lOuterBorderColor
  91.     
  92.     'draw inner shadow (bottom)
  93.     .pLine 0, m_iScaleHeight - 1, m_iScaleWidth, m_iScaleHeight - 1, m_lOuterBorderColor
  94.   End With
  95. End Sub
  96.  
  97. Private Sub ITheme_DrawBackgroundTabbedDialog()
  98.   Call ITheme_DrawBackgroundPropertyPages
  99. End Sub
  100.  
  101. 'these functions were seperated acc to theme so as to allow painting of only the desired parts (and not the whole control)
  102. Private Sub ITheme_DrawOnActiveTabChange()
  103.   Call ITheme_DrawTabs
  104. End Sub
  105.  
  106. Private Sub ITheme_DrawTabs()
  107.   
  108.   Call pCacheControlProperties     'cache the control proerties for faster access
  109.   With m_oXTab
  110.     Select Case .TabStyle
  111.       Case xStyleTabbedDialog:
  112.         Call ITheme_DrawTabsTabbedDialog
  113.       Case xStylePropertyPages:
  114.         Call Itheme_DrawTabsPropertyPages
  115.     End Select
  116.   End With
  117. End Sub
  118.  
  119. Private Sub Itheme_DrawTabsPropertyPages()
  120.   Dim iCnt As Integer
  121.   Dim iTabWidth As Integer
  122.   Dim utFontRect As RECT
  123.   Dim sTmp As String
  124.   Dim utTabInfo As TabInfo
  125.   
  126.   Dim iAdjustedIconSize As Integer
  127.   Dim iTmpY As Integer
  128.   Dim iTmpHeight As Integer
  129.  
  130.   'store the larger height in tmp var
  131.   iTmpHeight = IIf(m_iActiveTabHeight > m_iInActiveTabHeight, m_iActiveTabHeight, m_iInActiveTabHeight)
  132.   
  133.   
  134.   'Set the active tab's font as current font (since the TextWidth function
  135.   'will use the current font's size)
  136.   Set m_oXTab.oFont = m_oXTab.ActiveTabFont
  137.   
  138.   'initialize the clickable items
  139.   For iCnt = 0 To m_iTabCount - 1
  140.     
  141.     utTabInfo = m_oXTab.aryTabs(iCnt)     'get into local variable
  142.         
  143.     sTmp = Replace$(utTabInfo.Caption, "&&", "&")
  144.     
  145.     If InStr(1, sTmp, "&") Then
  146.       
  147.       'if still there is one '&' in the string then reduce the width by one more character (since the '&' will be conveted into an underline when painted)
  148.       sTmp = Mid$(sTmp, 1, Len(sTmp) - 1)
  149.     End If
  150.     
  151.     
  152.     If utTabInfo.TabPicture Is Nothing Then
  153.       'get tab width acc to the text size and border
  154.       iTabWidth = m_oXTab.pTextWidth(sTmp) + m_c_iPROP_PAGE_BORDER_AND_TEXT_DISTANCE * 2
  155.     Else
  156.       If iTmpHeight - 2 < m_iIconSize Then    '-6 for borders
  157.         'here we adjust the size of the icon if it does not fit into current tab
  158.         iAdjustedIconSize = iTmpHeight - 2
  159.       Else
  160.         iAdjustedIconSize = m_iIconSize
  161.       End If
  162.  
  163.       'get tab width acc to the text size, border and Image
  164.       iTabWidth = m_oXTab.pTextWidth(sTmp) + (m_c_iPROP_PAGE_BORDER_AND_TEXT_DISTANCE * 2) + iAdjustedIconSize + 1
  165.     End If
  166.     
  167.     
  168.     'get tab width acc to the text size and border
  169.     'iTabWidth = m_oXTab.pTextWidth(sTmp) + m_c_iPROP_PAGE_BORDER_AND_TEXT_DISTANCE * 2
  170.     
  171.     
  172.     
  173.     'following adjustments are used in case of property pages only. We must shift
  174.     'the left (+2) or (-2) to make it look like standard property pages
  175.     With utTabInfo.ClickableRect
  176.       If iCnt = 0 And iCnt <> m_iActiveTab Then
  177.         .Left = m_c_iPROP_PAGE_INACTIVE_TOP
  178.         .Right = .Left + iTabWidth - m_c_iPROP_PAGE_INACTIVE_TOP + 1
  179.       Else
  180.         If iCnt = 0 Then
  181.           .Left = 0
  182.         Else
  183.           'If iCnt = m_iActiveTab Or iCnt = m_iActiveTab + 1 Then
  184.           .Left = m_oXTab.aryTabs(iCnt - 1).ClickableRect.Right
  185.           
  186.           ' Else
  187.           '1 pixel distance between property pages (in XP)
  188.           '   .Left = m_oXTab.aryTabs(iCnt - 1).ClickableRect.Right + 1
  189.           ' End If
  190.         End If
  191.           
  192.         .Right = .Left + iTabWidth
  193.       End If
  194.         
  195.       If iCnt = m_iActiveTab Then
  196.         If m_iActiveTabHeight > m_iInActiveTabHeight Then
  197.           .Top = 0
  198.         Else
  199.           .Top = m_iInActiveTabHeight - m_iActiveTabHeight
  200.         End If
  201.         .Bottom = .Top + m_iActiveTabHeight
  202.       Else
  203.         If m_iInActiveTabHeight > m_iActiveTabHeight Then
  204.           .Top = 0
  205.           .Bottom = .Top + m_iInActiveTabHeight
  206.         Else
  207.           .Top = m_iActiveTabHeight - m_iInActiveTabHeight
  208.           .Bottom = .Top + m_iInActiveTabHeight
  209.         End If
  210.         
  211.       End If
  212.         
  213.     End With
  214.     
  215.     m_oXTab.aryTabs(iCnt) = utTabInfo       'assign the new tab info to the existing one
  216.     
  217.   Next
  218.   
  219.  
  220.   'fill the tab strip with TabStripBackColor (customizable... so that tab's can easily blend with the background)
  221.   m_oXTab.pLine 0, 0, m_iScaleWidth, IIf(m_iActiveTabHeight > m_iInActiveTabHeight, m_iActiveTabHeight, m_iInActiveTabHeight), m_oXTab.TabStripBackColor, True, True
  222.   
  223.   'Now Draw Each Tab
  224.   For iCnt = 0 To m_iTabCount - 1
  225.     utTabInfo = m_oXTab.aryTabs(iCnt)     'fetch local copy
  226.     
  227.     With utTabInfo.ClickableRect
  228.       
  229.       If iCnt = m_iActiveTab Then         'if we are drawing the active tab
  230.       
  231.         If utTabInfo.Enabled Then
  232.           m_oXTab.pFillCurvedGradient .Left, .Top, .Right, .Bottom, m_lActiveTabBackStartColor, m_lActiveTabBackEndColor
  233.         Else
  234.           m_oXTab.pFillCurvedGradient .Left, .Top, .Right, .Bottom, m_lDisabledTabBackColor, m_lDisabledTabBackColor
  235.         End If
  236.  
  237.         'top line
  238.         m_oXTab.pLine .Left, .Top, .Right, .Top, m_lOuterBorderColor
  239.         
  240.       
  241.         'right line
  242.         m_oXTab.pLine .Right, .Top, .Right, .Bottom + 2, m_lBottomRightInnerBorderColor
  243.         
  244.         If utTabInfo.Enabled Then
  245.           'bottom line  (actually we must erase the previously drawn background (since this is the active tab)
  246.           m_oXTab.pLine .Left, .Bottom + 1, .Right, .Bottom + 1, m_lActiveTabBackEndColor
  247.         Else
  248.           'bottom line  (actually we must erase the previously drawn background (since this is the active tab)
  249.           m_oXTab.pLine .Left, .Bottom + 1, .Right, .Bottom + 1, m_lDisabledTabBackColor
  250.         End If
  251.  
  252.         
  253.         'left line
  254.         m_oXTab.pLine .Left, .Top, .Left, .Bottom + 2, m_lOuterBorderColor
  255.         
  256.         Set m_oXTab.oFont = m_oXTab.ActiveTabFont       'set the active tab font as current font
  257.         
  258.         'set fore color
  259.         If utTabInfo.Enabled Then
  260.           m_oXTab.lForeColor = m_lActiveTabForeColor
  261.         Else
  262.           m_oXTab.lForeColor = m_lDisabledTabForeColor
  263.         End If
  264.         
  265.       Else      'its an inactive tab
  266.       
  267.         If utTabInfo.Enabled Then
  268.           If iCnt = m_iActiveTab + 1 Then   'if we are drawing tab just after active tab, then
  269.           
  270.             Call m_oXTab.pFillCurvedGradient(.Left + 1, .Top, .Right, .Bottom, m_lInActiveTabBackStartColor, m_lInActiveTabBackEndColor)
  271.             
  272.           Else  'we are drawing tab just b4 active tab, then
  273.           
  274.             Call m_oXTab.pFillCurvedGradient(.Left, .Top, .Right, .Bottom, m_lInActiveTabBackStartColor, m_lInActiveTabBackEndColor)
  275.             
  276.           End If
  277.         Else
  278.           If iCnt = m_iActiveTab + 1 Then 'if we are drawing tab just after active tab, then
  279.           
  280.             Call m_oXTab.pFillCurvedGradient(.Left + 1, .Top, .Right, .Bottom, m_lDisabledTabBackColor, m_lDisabledTabBackColor)
  281.             
  282.           Else    'we are drawing tab just b4 active tab, then
  283.           
  284.             Call m_oXTab.pFillCurvedGradient(.Left, .Top, .Right, .Bottom, m_lDisabledTabBackColor, m_lDisabledTabBackColor)
  285.             
  286.           End If
  287.         End If
  288.         
  289.         
  290.         'following is special in case of Visual studio .Net 2003 tabs , a simple line seperates two inactive tabs
  291.         If iCnt <> m_iActiveTab - 1 Then
  292.           'right line
  293.           m_oXTab.pLine .Right - 1, .Top + 2, .Right - 1, .Bottom - 2, m_lInActiveTabForeColor
  294.         End If
  295.         
  296.         'bottom line
  297.         m_oXTab.pLine .Left, .Bottom + 1, .Right + 1, .Bottom + 1, m_lOuterBorderColor
  298.         
  299.       
  300.         Set m_oXTab.oFont = m_oXTab.InActiveTabFont   'set the font
  301.         
  302.         'set fore color
  303.         If utTabInfo.Enabled Then
  304.           m_oXTab.lForeColor = m_lInActiveTabForeColor
  305.         Else
  306.           m_oXTab.lForeColor = m_lDisabledTabForeColor
  307.         End If
  308.         
  309.       End If
  310.  
  311.       'do the adjustments for the border
  312.       utFontRect.Left = .Left + 2
  313.       utFontRect.Top = .Top + 2
  314.       utFontRect.Bottom = .Bottom
  315.       utFontRect.Right = .Right - 1
  316.       
  317.       
  318.       sTmp = utTabInfo.Caption
  319.       
  320.       If Not utTabInfo.TabPicture Is Nothing Then
  321.         
  322.         If iTmpHeight - 6 < m_iIconSize Then    '-6 for borders
  323.           'here we adjust the size of the icon if it does not fit into current tab
  324.           iAdjustedIconSize = iTmpHeight - 6
  325.         Else
  326.           iAdjustedIconSize = m_iIconSize
  327.         End If
  328.     
  329.         iTmpY = utFontRect.Top + Round((utFontRect.Bottom - utFontRect.Top - iAdjustedIconSize) / 2)
  330.         
  331.         Select Case m_oXTab.PictureAlign
  332.           Case xAlignLeftEdge, xAlignLeftOfCaption:
  333.             
  334.             If utTabInfo.TabPicture.Type = vbPicTypeBitmap And m_oXTab.UseMaskColor Then
  335.               
  336.               Call DrawImage(m_lHDC, utTabInfo.TabPicture.Handle, g_pGetRGBFromOLE(m_oXTab.PictureMaskColor), utFontRect.Left + 2, iTmpY, iAdjustedIconSize, iAdjustedIconSize)
  337.               
  338.             Else
  339.               
  340.               Call m_oXTab.pPaintPicture(utTabInfo.TabPicture, utFontRect.Left + 2, iTmpY, iAdjustedIconSize, iAdjustedIconSize)
  341.               
  342.             End If
  343.             
  344.             'shift the text to be drawn after the picture
  345.             utFontRect.Left = (utFontRect.Left + iAdjustedIconSize + 6) - m_c_iPROP_PAGE_BORDER_AND_TEXT_DISTANCE
  346.             
  347.             'call the API for the text drawing
  348.             DrawText m_lHDC, sTmp, -1, utFontRect, DT_CENTER Or DT_VCENTER Or DT_SINGLELINE
  349.             
  350.             
  351.             'revert the changes so that the focus rectangle can be drawn for the whole tab's clickable area
  352.             utFontRect.Left = (utFontRect.Left - iAdjustedIconSize - 6) + m_c_iPROP_PAGE_BORDER_AND_TEXT_DISTANCE
  353.             
  354.           Case xAlignRightEdge, xAlignRightOfCaption:
  355.             
  356.             If utTabInfo.TabPicture.Type = vbPicTypeBitmap And m_oXTab.UseMaskColor Then
  357.               
  358.               Call DrawImage(m_lHDC, utTabInfo.TabPicture.Handle, g_pGetRGBFromOLE(m_oXTab.PictureMaskColor), utFontRect.Right - iAdjustedIconSize - 2, iTmpY, iAdjustedIconSize, iAdjustedIconSize)
  359.               
  360.             Else
  361.               
  362.               Call m_oXTab.pPaintPicture(utTabInfo.TabPicture, utFontRect.Right - iAdjustedIconSize - 2, iTmpY, iAdjustedIconSize, iAdjustedIconSize)
  363.               
  364.             End If
  365.             
  366.             'm_oXTab.pPaintPicture utTabInfo.TabPicture, utFontRect.Right - iAdjustedIconSize, iTmpY, iAdjustedIconSize, iAdjustedIconSize
  367.             
  368.             'shift the text to be drawn after the picture
  369.             utFontRect.Right = (utFontRect.Right + 1) - iAdjustedIconSize - 6
  370.             
  371.             'call the API for the text drawing
  372.             DrawText m_lHDC, sTmp, -1, utFontRect, DT_CENTER Or DT_VCENTER Or DT_SINGLELINE
  373.             
  374.             'revert the changes so that the focus rectangle can be drawn for the whole tab's clickable area
  375.             utFontRect.Right = (utFontRect.Right - 1) + iAdjustedIconSize + 6
  376.             
  377.         End Select
  378.         
  379.       Else
  380.         
  381.         'call the API for the text drawing
  382.         DrawText m_lHDC, sTmp, -1, utFontRect, DT_CENTER Or DT_VCENTER Or DT_SINGLELINE
  383.         
  384.       End If
  385.       
  386.       'call the API for the text drawing
  387.       'DrawText m_lHDC, sTmp, -1, utFontRect, DT_CENTER Or DT_VCENTER Or DT_SINGLELINE
  388.       
  389.       If m_oXTab.bUserMode Then    'only if in the run mode
  390.       
  391.         If iCnt = m_iActiveTab And m_bIsFocused And m_oXTab.ShowFocusRect Then
  392.           'draw focus rect
  393.           Call DrawFocusRect(m_lHDC, utFontRect)
  394.         End If
  395.       End If
  396.       
  397.     End With
  398.  
  399.     
  400.  
  401.   Next
  402.   
  403.   'store the larger tab height
  404.   iCnt = IIf(m_iActiveTabHeight > m_iInActiveTabHeight, m_iActiveTabHeight, m_iInActiveTabHeight)
  405.  
  406.   'adjust the corners
  407.   m_oXTab.pLine 0, iCnt + 1, 0, iCnt + 4, m_lOuterBorderColor
  408.   m_oXTab.pLine m_iScaleWidth - 1, iCnt + 1, m_iScaleWidth - 1, iCnt + 4, m_lOuterBorderColor
  409.   
  410.   'draw the line in the empty area after all the property pages heads are drawn
  411.   m_oXTab.pLine m_oXTab.aryTabs(m_iTabCount - 1).ClickableRect.Right, m_oXTab.aryTabs(m_iTabCount - 1).ClickableRect.Bottom + 1, m_iScaleWidth, m_oXTab.aryTabs(m_iTabCount - 1).ClickableRect.Bottom + 1, m_ge, xAlignLine 0, iCnt +ect. m_iInActivot.Left + iAdjustedIconSize +1, m_ge,sonSize +MEolforeee 0, ghtScaleWi, lforIpEsWi, lforIpEsWi, lforIpEsWi, lforIpEsWv_         'call the API(P xAli
  412.         call the property pa3_C6p 
  413.         'bottom line
  414.         m_oXTab.pLine_iTabCnt +ereft + iAdjustedIconSize +1, m_ge,sonSize +MEolforeee 0, gL   .ab.aryTabs(m_iTabCount - 1).ClickableRect.